home *** CD-ROM | disk | FTP | other *** search
/ Windows 6-Pak - Disc 5 / Windows 6-Pak (InfoMagic) (Disc 5) (1999).ISO / Misc-Programming-Tools / regen01.exe / SOURCE.ZIP / main.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-02  |  21KB  |  805 lines

  1. unit main;
  2.  
  3. {Source Code for Registry Enumerator (copy right) Greg Lorriman 1998.
  4.  
  5. Compiled with Delphi2.
  6.  
  7. email :greg@lorriman.demon.co.uk  web : http://www.lorriman.demon.co.uk
  8.  
  9. You will also need the RxLib components and Eric Fookes's super label components.
  10. }
  11.  
  12. interface
  13.  
  14. uses
  15.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  16.   StdCtrls, Ef_Edit, ComCtrls, ExtCtrls, Nestinfo, Buttons, Menus,registry,
  17.   Placemnt, FileOp;
  18.  
  19.  
  20.  
  21. type
  22.   TForm1 = class(TForm)
  23.     Panel1: TPanel;
  24.     Panel2: TPanel;
  25.     Panel3: TPanel;
  26.     Panel5: TPanel;
  27.     RichEdit1: TRichEdit;
  28.     MainMenu1: TMainMenu;
  29.     File1: TMenuItem;
  30.     SaveAs1: TMenuItem;
  31.     Save1: TMenuItem;
  32.     Open1: TMenuItem;
  33.     N1: TMenuItem;
  34.     Exit1: TMenuItem;
  35.     Edit1: TMenuItem;
  36.     Options1: TMenuItem;
  37.     Help1: TMenuItem;
  38.     copy1: TMenuItem;
  39.     N2: TMenuItem;
  40.     Selectall1: TMenuItem;
  41.     TextOnly1: TMenuItem;
  42.     DefaultsOnly1: TMenuItem;
  43.     HelpTopics1: TMenuItem;
  44.     N3: TMenuItem;
  45.     AboutRegenumerator1: TMenuItem;
  46.     Panel4: TPanel;
  47.     btnEnum: TButton;
  48.     sbStop: TSpeedButton;
  49.     StatusBar1: TStatusBar;
  50.     FormStorage1: TFormStorage;
  51.     Fullkeypaths1: TMenuItem;
  52.     N4: TMenuItem;
  53.     Other1: TMenuItem;
  54.     N5: TMenuItem;
  55.     OpenRegedit1: TMenuItem;
  56.     SaveDialog1: TSaveDialog;
  57.     OpenDialog1: TOpenDialog;
  58.     Paste1: TMenuItem;
  59.     EditPopUp: TPopupMenu;
  60.     Bold1: TMenuItem;
  61.     Tools1: TMenuItem;
  62.     BackupRegistry1: TMenuItem;
  63.     Panel6: TPanel;
  64.     cbxMaxDepth: TLblComboBox;
  65.     el_cbxMaxDepth: TEnhLabel;
  66.     Panel7: TPanel;
  67.     cbxKey: TLblComboBox;
  68.     el_cbxKey: TEnhLabel;
  69.     N6: TMenuItem;
  70.     Find1: TMenuItem;
  71.     FindNext1: TMenuItem;
  72.     Copy2: TMenuItem;
  73.     procedure btnEnumClick(Sender: TObject);
  74.     procedure FormResize(Sender: TObject);
  75.     procedure TextOnly1Click(Sender: TObject);
  76.     procedure DefaultsOnly1Click(Sender: TObject);
  77.     procedure AboutRegenumerator1Click(Sender: TObject);
  78.     procedure FormCreate(Sender: TObject);
  79.     procedure sbStopClick(Sender: TObject);
  80.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  81.     procedure Fullkeypaths1Click(Sender: TObject);
  82.     procedure Selectall1Click(Sender: TObject);
  83.     procedure copy1Click(Sender: TObject);
  84.     procedure Other1Click(Sender: TObject);
  85.     procedure FormDestroy(Sender: TObject);
  86.     procedure OpenRegedit1Click(Sender: TObject);
  87.     procedure Open1Click(Sender: TObject);
  88.     procedure SaveAs1Click(Sender: TObject);
  89.     procedure Save1Click(Sender: TObject);
  90.     procedure Edit1Click(Sender: TObject);
  91.     procedure Paste1Click(Sender: TObject);
  92.     procedure Bold1Click(Sender: TObject);
  93.     procedure BackupRegistry1Click(Sender: TObject);
  94.     procedure HelpTopics1Click(Sender: TObject);
  95.     procedure cbxMaxDepthChange(Sender: TObject);
  96.     procedure Stop1Click(Sender: TObject);
  97.     procedure FormKeyDown(Sender: TObject; var Key: Word;
  98.       Shift: TShiftState);
  99.     procedure Find1Click(Sender: TObject);
  100.     procedure FindNext1Click(Sender: TObject);
  101.     procedure Exit1Click(Sender: TObject);
  102.     procedure Copy2Click(Sender: TObject);
  103.     procedure EditPopUpPopup(Sender: TObject);
  104.   private
  105.  
  106.    addToResults : boolean;
  107.    indentVal : integer;
  108.    maxDepth : string;
  109.  
  110.     filename : string;
  111.    firstsave : boolean;
  112.  
  113.    searchWord : string;
  114.  
  115.    procedure setBold;
  116.  
  117.   public
  118.  
  119.  
  120. //although the following funcitons are methods this is only to aid the status bar update
  121. //the code that would need removing can be skipped by removing the ASMETHOD define
  122. //Which also explainsthe presence of a couple of global variables;
  123.    procedure regEnumerate(keyStr : string;DefaultsOnly, TextOnly, fullpath : boolean;
  124.         indent,maxDepth : integer;sl : TStrings);
  125.     procedure regprocesskey(key : string; DefaultsOnly, TextOnly, fullpath : boolean;
  126.        indent,maxDepth : integer; reg : TRegistry;sl : TStrings);
  127.     procedure findWord;
  128.  
  129.   end;
  130.  
  131. var
  132.   Form1: TForm1;
  133.  
  134. //general stuff
  135. function extractRootKey(str : string):HKEY;
  136. function getKeyName(key : string):string;
  137. function regIntToStr(const i : integer):string;
  138. function iifStr(cond : boolean;t,f : string):string;
  139. function trimchar(const s : string; const c :char):string;
  140. function getDesktopFolder:string;
  141. function createIndent(size, multiplier : integer):string;
  142. procedure checkforstop;
  143.  
  144. implementation
  145.  
  146. {$R *.DFM}
  147.  
  148. {$DEFINE ASMETHOD}
  149.  
  150. uses strutils,about,okcancl2,inifiles,filectrl;
  151.  
  152. //following is global to aid extraction of methods from class
  153. const stop : boolean=false;
  154.  
  155. procedure TForm1.btnEnumClick(Sender: TObject);
  156. var
  157.     strlist : TStringlist;
  158.    cntr : integer;
  159.    maxDepthVal,num : integer;
  160. begin
  161.     stop:=false;
  162.  
  163. //validate max depth
  164.       try
  165.        if cbxMaxDepth.text<>'(no limit)' then
  166.           num:=strtoint(cbxMaxDepth.text);
  167.        if num<0 then
  168.            abort;
  169.    except
  170.        raise exception.create('Max depth must be 0, positive number or (no limit)');
  171.    end;
  172.  
  173.    maxDepth:=cbxMaxDepth.text;
  174.  
  175. //update combo list
  176.     with cbxKey do begin
  177.        if text<>'' then
  178.           if items.indexof(text)=-1 then
  179.                items.insert(0,text);
  180.        while items.count>8 do
  181.            items.delete(items.count-1);
  182.     end;
  183.  
  184.  
  185.   strlist:=TStringlist.create;
  186.   if not addtoresults then
  187.       richedit1.lines.clear;
  188.  
  189. //disable controls
  190.   cbxKey.enabled:=false;
  191.   btnEnum.enabled:=false;
  192.   file1.enabled:=false;
  193.   edit1.enabled:=false;
  194.   options1.enabled:=false;
  195.   help1.enabled:=false;
  196.   sbStop.enabled:=true;
  197.   cbxMaxDepth.enabled:=false;
  198.   tools1.enabled:=false;
  199.  
  200. //work out max recursive depth
  201.     if maxDepth='(no limit)' then
  202.        maxDepthVal:=high(integer)
  203.    else
  204.        maxDepthVal:=strtoint(maxdepth);
  205.   try
  206.  
  207.          regEnumerate(trimchar(trim(cbxKey.text),'\'),
  208.               DefaultsOnly1.checked,TextOnly1.checked,Fullkeypaths1.checked,indentVal,maxDepthVal,strlist);
  209.  
  210.        statusbar1.panels.items[0].text:='Updating display (please wait)';
  211.       try
  212.       try
  213.       richedit1.lines.beginupdate;
  214.       for cntr:=0 to strlist.count-1 do begin
  215.          checkforstop;
  216.          //assign would have been easier? The stop button doesn't work and it takes ages.
  217.          richedit1.lines.add(strlist[cntr]);
  218.       end;
  219.       finally
  220.        richedit1.lines.endupdate;
  221.       end;
  222.       except
  223.        richedit1.lines.clear;
  224.       end;
  225.  
  226.   finally
  227.         statusbar1.panels.items[0].text:='Processing key :';
  228.           strlist.free;
  229.        cbxKey.enabled:=true;
  230.        btnEnum.enabled:=true;
  231.        sbStop.enabled:=false;
  232.        file1.enabled:=true;
  233.        edit1.enabled:=true;
  234.        options1.enabled:=true;
  235.        help1.enabled:=true;
  236.         cbxMaxDepth.enabled:=true;
  237.         tools1.enabled:=true;
  238.        richedit1.selstart:=0;
  239.   end;
  240. end;
  241.  
  242.  
  243. //well, we're not multi-threading, are we now?
  244. const recurseCount : integer=0;
  245.  
  246. procedure TForm1.regEnumerate(keyStr : string; DefaultsOnly, TextOnly,
  247.  fullpath : boolean; indent,maxDepth : integer;sl : TStrings);
  248. var
  249.     reg : TRegistry;
  250.    subKeyStr : string;
  251. begin
  252.     reg:=TRegistry.create;
  253.    try
  254.           sl.add('Enumeration of : '+cbxKey.text);
  255.        sl.add('Options : '+
  256.            iifStr(defaultsonly,'[Defaults only] ','')+
  257.            iifStr(TextOnly,'[Strings only] ','')+
  258.            iifStr(fullpath,'[Full Key Paths]',''));
  259.        sl.add('Values denoted by "@"');
  260.        reg.rootkey:=extractrootkey(keystr);
  261.        if pos('\',keystr)=0 then
  262.            subkeystr:=''
  263.        else begin
  264.              sl.add('');
  265.            subKeyStr:=copy(keyStr,pos('\',keystr),length(keystr)-pos('\',keystr)+1);
  266.        end;
  267.        //next function is recursive
  268.         regProcessKey(trimchar(subkeyStr,'\'),DefaultsOnly,TextOnly,fullpath,indent,maxDepth,reg,sl);
  269.    finally
  270.        reg.closekey;
  271.        reg.free;
  272.     end;
  273. end;
  274.  
  275. //recursive;
  276. procedure TForm1.regprocesskey(key : string; DefaultsOnly, TextOnly, fullpath : boolean;
  277.     indent,maxDepth : integer;reg : TRegistry;sl : TStrings);
  278. var subkeystrlist,valuelist : TStringlist;
  279.     valuetype : TRegDataType;
  280.    indentStr : string;
  281.    cntr : integer;
  282. begin
  283.  
  284.       if recurseCount>maxdepth then
  285.           exit;
  286.  
  287.    inc(recurseCount);
  288.  
  289.     subkeystrlist:=TStringlist.create;
  290.    valuelist:=TStringlist.create;
  291.    try
  292.  
  293.         checkforstop;
  294.        if not reg.openkey(key,false) then
  295.            raise exception.create('Error reading key');
  296.  
  297.        {$ifdef asmethod}
  298.        statusbar1.panels.items[0].text:='Processing key : '+key;
  299.        statusbar1.update;
  300. //       richedit1.defattributes.style:=richedit1.defattributes.style+[fsbold];
  301.        {$endif}
  302.  
  303.        indentStr:=createIndent(indent,recursecount);
  304.        sl.add('');
  305.        if fullpath then
  306.            sl.add(indentstr+key)
  307.        else
  308.            sl.add(indentstr+getkeyname(key));
  309.  
  310.        {$ifdef asmethod}
  311. //       richedit1.defattributes.style:=richedit1.defattributes.style-[fsbold];
  312.        {$endif}
  313.  
  314.        reg.getvaluenames(valuelist);
  315.        valuelist.sort;
  316.  
  317.        indentStr:=createIndent(indent,recursecount+1);
  318.        for cntr:=0 to valuelist.count-1 do begin
  319.           checkforstop;
  320.           if (cntr=0) and defaultsonly then begin
  321.               if valuelist[cntr]<>'' then begin
  322.               sl.add(indentstr+'@ : [value not set]');
  323.               break;
  324.            end;
  325.           end;
  326.  
  327.            valuetype:=reg.getdatatype(valuelist[cntr]);
  328.            if (valuetype=rdString) or (valuetype=rdExpandString) then
  329.                sl.add(indentStr+'@'+valuelist[cntr]+' : '+reg.readstring(valuelist[cntr]))
  330.            else if not textonly then begin
  331.                case valuetype of
  332.                    rdUnknown : sl.add(indentStr+'@'+valuelist[cntr]+' : [unkown]');
  333.                    rdInteger : sl.add(indentStr+'@'+valuelist[cntr]+' : [integer] hex : '+
  334.                        regIntToStr(reg.readinteger(valuelist[cntr]))+
  335.                        '  dec : '+inttostr(reg.readinteger(valuelist[cntr])));
  336.                    rdBinary :  sl.add(indentStr+'@'+valuelist[cntr]+' : [binary]');
  337.                end;
  338.            end;
  339.            if (cntr=0) and defaultsonly then
  340.                break;
  341.        end;
  342.  
  343.  
  344.        reg.getkeynames(subkeystrlist);
  345.        reg.closekey;
  346.        subkeystrlist.sort;
  347.        for cntr:=0 to subkeystrlist.count-1 do
  348.            regprocesskey(key+'\'+subkeystrlist[cntr],defaultsonly,textonly,fullpath,indent,maxdepth,reg,sl);
  349.  
  350.  
  351.    finally
  352.           dec(recurseCount);
  353.        subkeystrlist.free;
  354.        valuelist.free;
  355.        reg.closekey;
  356.       end;
  357. end;
  358.  
  359.  
  360.  
  361. function extractRootKey(str : string):HKEY;
  362. begin
  363.   str:=ExtractWord(1,Str,['\']);
  364.    if uppercase(str)='HKEY_CLASSES_ROOT' then
  365.        result:=HKEY_CLASSES_ROOT
  366.    else if uppercase(str)='HKEY_CURRENT_USER' then
  367.        result:=HKEY_CURRENT_USER
  368.    else if uppercase(str)='HKEY_LOCAL_MACHINE' then
  369.        result:=HKEY_LOCAL_MACHINE
  370.    else if uppercase(str)='HKEY_USERS' then
  371.        result:=HKEY_USERS
  372.    else if uppercase(str)='HKEY_CURRENT_CONFIG' then
  373.        result:=HKEY_CURRENT_CONFIG
  374.    else if uppercase(str)='HKEY_DYN_DATA' then
  375.        result:=HKEY_DYN_DATA
  376.    else begin
  377.        raise exception.create('Root key not recognised');
  378.    end;
  379. end;
  380.  
  381. procedure TForm1.FormResize(Sender: TObject);
  382. begin
  383.     cbxKey.width:=cbxKey.parent.width-10-cbxKey.left;
  384. end;
  385.  
  386. procedure TForm1.TextOnly1Click(Sender: TObject);
  387. begin
  388.     with textonly1 do
  389.        checked:=not checked;
  390.  
  391. end;
  392.  
  393. procedure TForm1.DefaultsOnly1Click(Sender: TObject);
  394. begin
  395.     with defaultsonly1 do
  396.        checked:=not checked;
  397.  
  398. end;
  399.  
  400. procedure TForm1.AboutRegenumerator1Click(Sender: TObject);
  401. begin
  402.     with Taboutbox.create(nil) do begin
  403.     try
  404.        showmodal
  405.    finally
  406.        free;
  407.    end;
  408.    end;
  409. end;
  410.  
  411. procedure TForm1.FormCreate(Sender: TObject);
  412. begin
  413.     firstsave:=true;
  414.     stop:=false;
  415.    application.showhint:=true;
  416.    with Tinifile.create('regenum.ini') do begin
  417.        try
  418.        indentval:=readinteger('Opts','Indent',5);
  419.        addtoresults:=readbool('Opts','addtoresults',false);
  420.        self.filename:=readstring('General','Filename','');
  421.        bold1.checked:=readbool('General','Bold',true);
  422.        maxDepth:=readstring('Opts','MaxDepth','1');
  423.        finally
  424.            free;
  425.        end;
  426.    end;
  427.    setbold;
  428. end;
  429.  
  430. procedure TForm1.sbStopClick(Sender: TObject);
  431. begin
  432.     stop:=true;
  433. end;
  434.  
  435. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  436. begin
  437. stop:=true;
  438. end;
  439.  
  440. procedure TForm1.Fullkeypaths1Click(Sender: TObject);
  441. begin
  442.     with Fullkeypaths1 do
  443.        checked:=not checked;
  444.  
  445. end;
  446.  
  447. function getKeyName(key : string):string;
  448. var
  449.     lastSlashPos : integer;
  450.    cntr : integer;
  451. begin
  452.     if pos('\',key)=0 then
  453.        result:=key
  454.     else begin
  455.        for cntr:=length(key) downto 1 do begin
  456.            lastSlashPos:=cntr;
  457.            if key[cntr]='\' then
  458.                break;
  459.        end;
  460.        result:=copy(key,lastSlashpos+1,length(key)-lastslashpos);
  461.    end;
  462. end;
  463.  
  464. function createIndent(size, multiplier : integer):string;
  465. var
  466.     s : string;
  467.    len,cntr : integer;
  468. begin;
  469.     len :=size*multiplier;
  470.     setlength(s,len);
  471.    for cntr:=1 to len do
  472.        s[cntr]:=' ';
  473.    result:=s;
  474. end;
  475.  
  476. function regIntToStr(const i : integer):string;
  477. var
  478.     str,str1,str2 : string;
  479.    spos,cntr : integer;
  480.    x : integer;
  481. begin
  482.  
  483. //    x:=356;
  484.     str:=format('%x',[i]);
  485.    str1:='00000000';
  486.    spos:=8-length(str);
  487.    for cntr:=1 to length(str) do
  488.        str1[cntr+spos]:=str[cntr];
  489.    str2:='';
  490.    for cntr:=1 to length(str1) do begin
  491.        str2:=str2+str1[cntr];
  492.        if (cntr mod 2)=0 then
  493.            str2:=str2+' ';
  494.    end;
  495.    result:=str2;
  496. end;
  497.  
  498. function iifStr(cond : boolean;t,f : string):string;
  499. begin
  500.     if cond then
  501.        result:=t
  502.    else
  503.        result:=f;
  504. end;
  505.  
  506. function trimchar(const s : string; const c :char):string;
  507. var
  508.   I, L: Integer;
  509. begin
  510.   L := Length(S);
  511.   I := 1;
  512.   while (I <= L) and (S[I] = c) do Inc(I);
  513.   if I > L then Result := '' else
  514.   begin
  515.     while S[L] = c do system.Dec(L);
  516.     Result := Copy(S, I, L - I + 1);
  517.   end;
  518. end;
  519.  
  520.  
  521. procedure TForm1.Selectall1Click(Sender: TObject);
  522. begin
  523. richedit1.selectall;
  524. end;
  525.  
  526. procedure TForm1.copy1Click(Sender: TObject);
  527. begin
  528. richedit1.copytoclipboard;
  529. end;
  530.  
  531. procedure TForm1.Other1Click(Sender: TObject);
  532. begin
  533.     with TOKRightDlg.create(nil) do begin
  534.    try
  535.        cbAddToResults.checked:=addtoresults;
  536.        edIndent.text:=inttostr(indentVal);
  537. //       cbxMaxDepth.text:=maxDepth;
  538.        if showmodal=mrOk then begin
  539.            addtoresults:=cbAddToResults.checked;
  540.            indentVal:=strtoint(edIndent.text);
  541. //           maxDepth:=cbxMaxDepth.text;
  542.        end;
  543.    finally
  544.        free;
  545.    end;
  546.    end;
  547.  
  548. end;
  549.  
  550. procedure TForm1.FormDestroy(Sender: TObject);
  551. begin
  552.    with Tinifile.create('regenum.ini') do begin
  553.        try
  554.        writeinteger('Opts','Indent',indentval);
  555.        writebool('Opts','addtoresults',addtoresults);
  556.        writestring('General','Filename',self.filename);
  557.        writestring('Opts','MaxDepth',maxDepth);
  558.        writebool('General','Bold',bold1.checked);
  559.        finally
  560.            free;
  561.        end;
  562.    end;
  563.  
  564. end;
  565.  
  566. procedure TForm1.OpenRegedit1Click(Sender: TObject);
  567. begin
  568.     winexec('regedit.exe',sw_SHOW);
  569. end;
  570.  
  571. procedure TForm1.Open1Click(Sender: TObject);
  572. var
  573.     folder : string;
  574. begin
  575.    if filename='' then
  576.        folder:=getdesktopfolder
  577.    else
  578.        folder:=extractfilepath(filename);
  579.    with opendialog1 do begin
  580.        initialdir:=folder;
  581.        filename:=self.filename;
  582.        if execute then begin
  583.            richedit1.lines.loadfromfile(filename);
  584.            self.filename:=filename;
  585.            caption:='REgistry enumerator : '+extractfilename(filename);
  586.        end;
  587.    end;
  588. end;
  589.  
  590. procedure TForm1.SaveAs1Click(Sender: TObject);
  591. var
  592.     folder : string;
  593. begin
  594.    if filename='' then
  595.        folder:=getdesktopfolder
  596.    else
  597.        folder:=extractfilepath(filename);
  598.  
  599.    with savedialog1 do begin
  600.        initialdir:=folder;
  601.       filename:=self.filename;
  602.       if execute then begin
  603.           richedit1.lines.savetofile(filename);
  604.        firstsave:=false;
  605.        caption:='Registry enumerator : '+extractfilename(filename);
  606.        self.filename:=filename;
  607.       end;
  608.    end;
  609. end;
  610.  
  611.  
  612. function getDesktopFolder:string;
  613. begin
  614.     with TRegistry.create do begin
  615.        try
  616.        try
  617.        rootkey:=HKEY_USERS;
  618.        if openkey('.Default\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders',false) then
  619.            result:=readstring('Desktop')
  620.        else
  621.            result:='C:';
  622.        finally
  623.            closekey;
  624.            free;
  625.        end;
  626.        except
  627.            result:='C:';
  628.        end;
  629.    end
  630. end;
  631.  
  632.  
  633. procedure TForm1.Save1Click(Sender: TObject);
  634. begin
  635.     if firstsave or (filename='') then
  636.        saveas1click(self)
  637.    else begin
  638.         richedit1.lines.savetofile(filename);
  639.        firstsave:=false;
  640.    end;
  641.  
  642. end;
  643.  
  644. procedure checkforstop;
  645. begin
  646.     application.processmessages;
  647.        if stop then begin
  648.            stop:=false;
  649.            abort;
  650.        end;
  651. end;
  652.  
  653.  
  654.  
  655. procedure TForm1.Edit1Click(Sender: TObject);
  656. begin
  657.     paste1.enabled:=activecontrol=cbxKey;
  658. end;
  659.  
  660. procedure TForm1.Paste1Click(Sender: TObject);
  661. begin
  662. //    cbxKey.pastefromclipboard;
  663. end;
  664.  
  665. procedure TForm1.Bold1Click(Sender: TObject);
  666. begin
  667.     with bold1 do checked:=not checked;
  668.     setBold;
  669. end;
  670. procedure TForm1.BackupRegistry1Click(Sender: TObject);
  671. var
  672. //certain functions are unreliable with typecast long strings, hence a pchar :
  673.    pwindir : pchar;
  674.    windir : string;
  675.    mess : string;
  676.    ret1,ret2 : bool;
  677.    source,dest : string;
  678. begin
  679. //it would have been nice to have used TFileOperation component (from DSP) but
  680. //error checking was inadequate.
  681.     getmem(pwindir,MAX_PATH+1);
  682.    try
  683.        getwindowsdirectory(pwindir,MAX_PATH);
  684.        winDir:=strpas(pwindir);
  685.        {$i+}
  686.        if not directoryexists(windir+'\regbackup') then
  687.            mkdir(windir+'\regbackup');
  688.  
  689.          filesetattr(windir+'\regbackup\user.dat',0);
  690.          filesetattr(windir+'\regbackup\system.dat',0);
  691.  
  692.        source:=windir+'\system.dat';
  693.        dest:=windir+'\regbackup\system.dat';
  694.        ret1:=copyfile(pchar(source),pchar(dest),false);
  695.  
  696.        source:=windir+'\user.dat';
  697.        dest:=windir+'\regbackup\user.dat';
  698.        ret2:=copyfile(pchar(source),pchar(dest),false);
  699.  
  700.        //copy across restore instructions
  701.        source:=extractfilepath(paramstr(0))+'\restore.txt';
  702.        dest:=windir+'\regbackup\restore.txt';
  703.        copyfile(pchar(source),pchar(dest),false);
  704.  
  705.          filesetattr(windir+'\regbackup\user.dat',0);
  706.          filesetattr(windir+'\regbackup\system.dat',0);
  707.  
  708.         if (ret1=false) or (ret2=false) then
  709.            raise exception.create('Could not backup registry')
  710.        else begin
  711.             mess:='Registry saved to : '+windir+'\regbackup';
  712.            application.messagebox(pchar(mess),'Registry Backup',mb_OK);
  713.        end;
  714.    finally
  715.        freemem(pwindir,MAX_PATH+1);
  716.    end;
  717.  
  718. end;
  719.  
  720. procedure TForm1.HelpTopics1Click(Sender: TObject);
  721. begin
  722.     application.helpcontext(10);
  723. end;
  724.  
  725. procedure TForm1.cbxMaxDepthChange(Sender: TObject);
  726. begin
  727.     maxDepth:=cbxmaxdepth.text;
  728. end;
  729.  
  730. procedure TForm1.Stop1Click(Sender: TObject);
  731. begin
  732.     stop:=true;
  733. end;
  734.  
  735. procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  736.   Shift: TShiftState);
  737. begin
  738.  
  739.     if (ssAlt in shift) and ((key=byte('s')) or (key=byte('S'))) then
  740.        stop:=true;
  741. end;
  742.  
  743. procedure TForm1.Find1Click(Sender: TObject);
  744. begin
  745.     if inputquery('Find','Text to find',SearchWord)  and (searchword<>'') then
  746.        findWord;
  747. end;
  748.  
  749. procedure Tform1.findWord;
  750. var
  751.     beforeSearchPos,SearchPos : integer;
  752. begin
  753.  
  754.     if searchWord='' then begin
  755.         find1click(self);
  756.        exit;
  757.    end;
  758.    with richedit1 do begin
  759.        selstart:=selstart+sellength;
  760.        beforeSearchPos:=selstart+sellength;
  761.        SearchPos:=findtext(searchword,selstart,length(text)-selstart,[]);
  762.        sendMessage(handle,EM_SETSEL,searchPos,SearchPos+length(searchword));
  763.        Refresh;
  764.        setfocus;
  765.  
  766.        if beforeSearchPos=(selstart+sellength) then
  767.            raise exception.create('Not found');
  768.    end;
  769.  
  770. end;
  771.  
  772.  
  773. procedure TForm1.FindNext1Click(Sender: TObject);
  774. begin
  775.     findword;
  776. end;
  777.  
  778. procedure TForm1.Exit1Click(Sender: TObject);
  779. begin
  780. stop:=true;
  781. close;
  782. end;
  783.  
  784. procedure TForm1.Copy2Click(Sender: TObject);
  785. begin
  786.     richedit1.copytoclipboard;
  787. end;
  788.  
  789. procedure TForm1.EditPopUpPopup(Sender: TObject);
  790. begin
  791.     copy2.enabled:=richedit1.sellength>0;
  792. end;
  793.  
  794. procedure TForm1.setBold;
  795. begin
  796.  with bold1 do begin
  797.    if checked then
  798.         richedit1.font.style:=[fsbold]+richedit1.font.style
  799.     else
  800.           richedit1.font.style:=richedit1.font.style-[fsbold];
  801.  end;
  802. end;
  803.  
  804. end.
  805.